module static_mod

  use spark_cubed_sphere
  use params_mod

  implicit none

  private

  public static_type
  public static

  type static_panel_array_type
    real(r_kind), pointer, dimension(  :,:,:) :: gravity       ! gavity acceleration on cell average, unit: m^2 * s^-2
    real(r_kind), pointer, dimension(:,:,:,:) :: gravityQ      ! gavity acceleration on quadrature points, unit: m^2 * s^-2
    
    real(r8), pointer, dimension(:,:,:) :: rdc ! Rayleigh damping coefficient on cell center point
    
    ! For barotropic model
    ! 1: quadrature point
    ! 2: x-axis
    ! 3: y-axis
    ! 4: z-axis
    !                            1 2 3 4
    real(r_kind), pointer, dimension(  :,:  ) :: coriolisC ! Coriolis parameter on cell center
    real(r_kind), pointer, dimension(:,:,:  ) :: coriolisQ ! Coriolis parameter on quadrature points
    real(r_kind), pointer, dimension(  :,:  ) :: ghs       ! geopotential height of surface on cell average
    real(r_kind), pointer, dimension(  :,:  ) :: ghsC      ! geopotential height of surface on cell center
    real(r_kind), pointer, dimension(:,:,:  ) :: ghsL      ! geopotential height of surface on left points
    real(r_kind), pointer, dimension(:,:,:  ) :: ghsR      ! geopotential height of surface on right points
    real(r_kind), pointer, dimension(:,:,:  ) :: ghsB      ! geopotential height of surface on bottom points
    real(r_kind), pointer, dimension(:,:,:  ) :: ghsT      ! geopotential height of surface on top points
    real(r_kind), pointer, dimension(:,:,:  ) :: ghsQ      ! geopotential height of surface on quadrature points
    
    ! For barolinic model
    ! 1: quadrature point
    ! 2: x-axis
    ! 3: y-axis
    
    !                                1 2 3
    real(r_kind), pointer, dimension(  :,:) :: zs      ! Surface height on cell average
    real(r_kind), pointer, dimension(  :,:) :: zsC     ! Surface height on cell center point
    real(r_kind), pointer, dimension(:,:,:) :: zsL     ! Surface height on left points
    real(r_kind), pointer, dimension(:,:,:) :: zsR     ! Surface height on right points
    real(r_kind), pointer, dimension(:,:,:) :: zsB     ! Surface height on bottom points
    real(r_kind), pointer, dimension(:,:,:) :: zsT     ! Surface height on top points
    real(r_kind), pointer, dimension(:,:,:) :: zsD     ! Surface height on down points
    real(r_kind), pointer, dimension(:,:,:) :: zsU     ! Surface height on up points
    real(r_kind), pointer, dimension(:,:,:) :: zsQ     ! Surface height on quadrature points
    
    real(r_kind), pointer, dimension(  :,:) :: dzsdx
    real(r_kind), pointer, dimension(  :,:) :: dzsdxC
    real(r_kind), pointer, dimension(:,:,:) :: dzsdxL
    real(r_kind), pointer, dimension(:,:,:) :: dzsdxR
    real(r_kind), pointer, dimension(:,:,:) :: dzsdxB
    real(r_kind), pointer, dimension(:,:,:) :: dzsdxT
    real(r_kind), pointer, dimension(:,:,:) :: dzsdxD
    real(r_kind), pointer, dimension(:,:,:) :: dzsdxU
    real(r_kind), pointer, dimension(:,:,:) :: dzsdxQ
    
    real(r_kind), pointer, dimension(  :,:) :: dzsdy
    real(r_kind), pointer, dimension(  :,:) :: dzsdyC
    real(r_kind), pointer, dimension(:,:,:) :: dzsdyL
    real(r_kind), pointer, dimension(:,:,:) :: dzsdyR
    real(r_kind), pointer, dimension(:,:,:) :: dzsdyB
    real(r_kind), pointer, dimension(:,:,:) :: dzsdyT
    real(r_kind), pointer, dimension(:,:,:) :: dzsdyD
    real(r_kind), pointer, dimension(:,:,:) :: dzsdyU
    real(r_kind), pointer, dimension(:,:,:) :: dzsdyQ
    
    real(r_kind), pointer, dimension(:,:) :: landfrac
    real(r_kind), pointer, dimension(:,:) :: slmsk
  end type static_panel_array_type

  type static_type
    logical :: initialized = .false.
    type(cubed_sphere_mesh_type), pointer :: mesh => null()
    type(cubed_sphere_array_type) array
    type(static_panel_array_type) domain(6)
  contains
    procedure :: init  => static_init
    procedure :: clear => static_clear
    final :: static_final
  end type static_type

  type(static_type) static

contains

  subroutine static_init(this, mesh)

    class(static_type), intent(inout) :: this
    type(cubed_sphere_mesh_type), intent(in), target :: mesh

    integer idom

    call this%clear()

    this%mesh => mesh
    call this%array%init(mesh)
    
    call this%array%add_var('gravity' , &
      dtype='r8', &
      long_name='gavity acceleration', &
      units='m^2 * s^-2', &
      loc='CQ:CA', &
      with_halo='T:T', &
      fill_halo='F:F', &
      output   ='F:F')
    
    select case(model_type)
    case(0)
      call this%array%add_var('ghs', &
        dtype='r8', &
        long_name='Surface geopotential', &
        units='m2 s-2', &
        loc='C:CA:CQ:LQ:RQ:TQ:BQ', &
        with_halo='T:T:T:T:T:T:T', &
        fill_halo='F:F:F:F:F:F:F', &
        output='F:T:F:F:F:F:F', &
        only_2d=.true.)
    case(1) ! barotropic model
      call this%array%add_var('coriolis', &
        dtype='r8', &
        long_name='Coriolis parameter', &
        units='s-1', &
        loc='C:CQ', &
        with_halo='T:T', &
        fill_halo='F:F', &
        output='F:F', &
        only_2d=.true.)
      call this%array%add_var('ghs', &
        dtype='r8', &
        long_name='Surface geopotential', &
        units='m2 s-2', &
        loc='C:CA:CQ:LQ:RQ:TQ:BQ', &
        with_halo='T:T:T:T:T:T:T', &
        fill_halo='F:F:F:F:F:F:F', &
        output='F:T:F:F:F:F:F', &
        only_2d=.true.)
    case(2) ! barolinic model
      call this%array%add_var('rdc', &
        dtype='r8', &
        long_name='Rayleigh damping coefficient', &
        units='-', &
        loc='C', &
        with_halo='T', &
        fill_halo='F', &
        output='F')
      
      call this%array%add_var('zs', &
        dtype='r8', &
        long_name='Surface height', &
        units='m', &
        loc='C:CA:CQ:LQ:RQ:TQ:BQ:DQ:UQ', &
        with_halo='T:T:T:T:T:T:T:T:T', &
        fill_halo='T:T:F:F:F:F:F:F:F', &
        output   ='F:T:F:F:F:F:F:F:F', &
        only_2d=.true.)
      
      call this%array%add_var('dzsdx', &
        dtype='r8', &
        long_name='Surface height derivative in x-dir', &
        units='m/rad', &
        loc='C:CA:CQ:LQ:RQ:TQ:BQ:DQ:UQ', &
        with_halo='T:T:T:T:T:T:T:T:T', &
        fill_halo='T:T:F:F:F:F:F:F:F', &
        output   ='F:T:F:F:F:F:F:F:F', &
        only_2d=.true.)
      call this%array%add_var('dzsdy', &
        dtype='r8', &
        long_name='Surface height derivative in y-dir', &
        units='m/rad', &
        loc='C:CA:CQ:LQ:RQ:TQ:BQ:DQ:UQ', &
        with_halo='T:T:T:T:T:T:T:T:T', &
        fill_halo='T:T:F:F:F:F:F:F:F', &
        output   ='F:T:F:F:F:F:F:F:F', &
        only_2d=.true.)
      
      call this%array%add_var('landfrac', &
        dtype='r8', &
        long_name='Land Fraction', &
        units='-', &
        loc='CA', &
        with_halo='T', &
        fill_halo='T', &
        output='F', &
        only_2d=.true.)
      call this%array%add_var('slmsk', &
        dtype='r8', &
        long_name='Sea land mask', &
        units='-', &
        loc='CA', &
        with_halo='T', &
        fill_halo='T', &
        output='F', &
        only_2d=.true.)
    end select

    call this%array%allocate_arrays()
    
    do idom = 1, 6
      if (mesh%domain(idom)%initialized) then
        call this%array%get_array(this%domain(idom)%gravity , idom=idom, var_name='gravity', loc='CA')
        call this%array%get_array(this%domain(idom)%gravityQ, idom=idom, var_name='gravity', loc='CQ')
      end if
    end do

    select case(model_type)
    case(0)
      do idom = 1, 6
        if (mesh%domain(idom)%initialized) then
          call this%array%get_array(this%domain(idom)%ghs      , idom=idom, var_name='ghs'     , loc='CA')
          call this%array%get_array(this%domain(idom)%ghsC     , idom=idom, var_name='ghs'     , loc='C' )
          call this%array%get_array(this%domain(idom)%ghsL     , idom=idom, var_name='ghs'     , loc='LQ')
          call this%array%get_array(this%domain(idom)%ghsR     , idom=idom, var_name='ghs'     , loc='RQ')
          call this%array%get_array(this%domain(idom)%ghsB     , idom=idom, var_name='ghs'     , loc='BQ')
          call this%array%get_array(this%domain(idom)%ghsT     , idom=idom, var_name='ghs'     , loc='TQ')
          call this%array%get_array(this%domain(idom)%ghsQ     , idom=idom, var_name='ghs'     , loc='CQ')
        end if
      end do
    case(1)
      do idom = 1, 6
        if (mesh%domain(idom)%initialized) then
          call this%array%get_array(this%domain(idom)%coriolisC, idom=idom, var_name='coriolis', loc='C')
          call this%array%get_array(this%domain(idom)%coriolisQ, idom=idom, var_name='coriolis', loc='CQ')

          call this%array%get_array(this%domain(idom)%ghs      , idom=idom, var_name='ghs'     , loc='CA')
          call this%array%get_array(this%domain(idom)%ghsC     , idom=idom, var_name='ghs'     , loc='C' )
          call this%array%get_array(this%domain(idom)%ghsL     , idom=idom, var_name='ghs'     , loc='LQ')
          call this%array%get_array(this%domain(idom)%ghsR     , idom=idom, var_name='ghs'     , loc='RQ')
          call this%array%get_array(this%domain(idom)%ghsB     , idom=idom, var_name='ghs'     , loc='BQ')
          call this%array%get_array(this%domain(idom)%ghsT     , idom=idom, var_name='ghs'     , loc='TQ')
          call this%array%get_array(this%domain(idom)%ghsQ     , idom=idom, var_name='ghs'     , loc='CQ')
        end if
      end do
    case(2)
      do idom = 1, mesh%ndom
        if (mesh%domain(idom)%initialized) then
          call this%array%get_array(this%domain(idom)%rdc, idom=idom, loc='C', var_name='rdc')
          
          call this%array%get_array(this%domain(idom)%zs      , idom=idom, var_name='zs'      , loc='CA')
          call this%array%get_array(this%domain(idom)%zsC     , idom=idom, var_name='zs'      , loc='C' )
          call this%array%get_array(this%domain(idom)%zsL     , idom=idom, var_name='zs'      , loc='LQ')
          call this%array%get_array(this%domain(idom)%zsR     , idom=idom, var_name='zs'      , loc='RQ')
          call this%array%get_array(this%domain(idom)%zsB     , idom=idom, var_name='zs'      , loc='BQ')
          call this%array%get_array(this%domain(idom)%zsT     , idom=idom, var_name='zs'      , loc='TQ')
          call this%array%get_array(this%domain(idom)%zsD     , idom=idom, var_name='zs'      , loc='DQ')
          call this%array%get_array(this%domain(idom)%zsU     , idom=idom, var_name='zs'      , loc='UQ')
          call this%array%get_array(this%domain(idom)%zsQ     , idom=idom, var_name='zs'      , loc='CQ')
          
          call this%array%get_array(this%domain(idom)%dzsdx      , idom=idom, var_name='dzsdx'      , loc='CA')
          call this%array%get_array(this%domain(idom)%dzsdxC     , idom=idom, var_name='dzsdx'      , loc='C' )
          call this%array%get_array(this%domain(idom)%dzsdxL     , idom=idom, var_name='dzsdx'      , loc='LQ')
          call this%array%get_array(this%domain(idom)%dzsdxR     , idom=idom, var_name='dzsdx'      , loc='RQ')
          call this%array%get_array(this%domain(idom)%dzsdxB     , idom=idom, var_name='dzsdx'      , loc='BQ')
          call this%array%get_array(this%domain(idom)%dzsdxT     , idom=idom, var_name='dzsdx'      , loc='TQ')
          call this%array%get_array(this%domain(idom)%dzsdxD     , idom=idom, var_name='dzsdx'      , loc='DQ')
          call this%array%get_array(this%domain(idom)%dzsdxU     , idom=idom, var_name='dzsdx'      , loc='UQ')
          call this%array%get_array(this%domain(idom)%dzsdxQ     , idom=idom, var_name='dzsdx'      , loc='CQ')
          
          call this%array%get_array(this%domain(idom)%dzsdy      , idom=idom, var_name='dzsdy'      , loc='CA')
          call this%array%get_array(this%domain(idom)%dzsdyC     , idom=idom, var_name='dzsdy'      , loc='C' )
          call this%array%get_array(this%domain(idom)%dzsdyL     , idom=idom, var_name='dzsdy'      , loc='LQ')
          call this%array%get_array(this%domain(idom)%dzsdyR     , idom=idom, var_name='dzsdy'      , loc='RQ')
          call this%array%get_array(this%domain(idom)%dzsdyB     , idom=idom, var_name='dzsdy'      , loc='BQ')
          call this%array%get_array(this%domain(idom)%dzsdyT     , idom=idom, var_name='dzsdy'      , loc='TQ')
          call this%array%get_array(this%domain(idom)%dzsdyD     , idom=idom, var_name='dzsdy'      , loc='DQ')
          call this%array%get_array(this%domain(idom)%dzsdyU     , idom=idom, var_name='dzsdy'      , loc='UQ')
          call this%array%get_array(this%domain(idom)%dzsdyQ     , idom=idom, var_name='dzsdy'      , loc='CQ')
          
          call this%array%get_array(this%domain(idom)%landfrac, idom=idom, var_name='landfrac', loc='CA')
          call this%array%get_array(this%domain(idom)%slmsk   , idom=idom, var_name='slmsk'   , loc='CA')
        end if
      end do
    end select
    
    this%initialized = .true.

  end subroutine static_init

  subroutine static_clear(this)

    class(static_type), intent(inout) :: this

    call this%array%clear()

    this%initialized = .false.

  end subroutine static_clear

  subroutine static_final(this)

    type(static_type), intent(inout) :: this

    call static%clear()

  end subroutine static_final

end module static_mod
